Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/multi-1a/frmmain.frm

Text File | 1999-08-27 | 5KB | 177 lines

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain
   Caption         =   "Chat - Server"
   ClientHeight    =   2820
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   6645
   LinkTopic       =   "Form1"
   ScaleHeight     =   188
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   443
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox txtInput
      BackColor       =   &H00E0E0E0&
      Height          =   285
      Left            =   120
      TabIndex        =   0
      Top             =   2400
      Width           =   6375
   End
   Begin VB.TextBox txtOutput
      BackColor       =   &H00E0E0E0&
      Enabled         =   0   'False
      Height          =   2175
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   120
      Width           =   6375
   End
   Begin MSWinsockLib.Winsock sckServer
      Index           =   0
      Left            =   480
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckListening
      Left            =   0
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Menu File
      Caption         =   "&File"
      Begin VB.Menu line
         Caption         =   "-"
      End
      Begin VB.Menu Exit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu Options
      Caption         =   "&Options"
      Begin VB.Menu KickUser
         Caption         =   "K&ick User"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Exit_Click()
End
End Sub

Private Sub Form_Load()
For x = 1 To 49
Load sckServer(x)
User(x).FreeSocket = True
Next x
User(0).FreeSocket = True
sckListening.LocalPort = 1000
sckListening.Listen
Me.Caption = "Server - " & sckListening.LocalIP
End Sub

Private Sub Form_Resize()
On Error Resume Next
txtInput.Top = frmMain.ScaleHeight - 30
txtInput.Width = frmMain.ScaleWidth - 16
txtOutput.Width = frmMain.ScaleWidth - 16
txtOutput.Height = frmMain.ScaleHeight - 45
txtOutput.Left = 8
txtInput.Left = 8
End Sub

Private Sub Form_Terminate()
On Error Resume Next
For x = 1 To 49
Unload sckServer(x)
Next x
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
For x = 1 To 49
Unload sckServer(x)
Next x
End Sub

Private Sub KickUser_Click()
Dim Output As String
Output = InputBox("Who would you like to kick?", "Who:")
For x = 0 To 49
If User(x).FreeSocket = False Then
If LCase(Output) = LCase(User(x).Name) Then
Output = InputBox("For what reason are you kicking?", "Reason:")
sckServer(x).SendData "Kicked" & vbTab & Output & vbCrLf
DoEvents
Exit Sub
End If
End If
Next x
MsgBox "No one in the chat has that name!", vbInformation, "Note:"
End Sub

Private Sub sckListening_ConnectionRequest(ByVal requestID As Long)
For x = 0 To 49
If User(x).FreeSocket = True Then
User(x).FreeSocket = False
sckServer(x).Accept requestID
Exit For
End If
Next x
End Sub

Private Sub sckServer_Close(Index As Integer)
User(Index).FreeSocket = True
SendMessage User(Index).Name & " has left the chat!"
User(Index).Name = ""
sckServer(Index).Close
End Sub

Private Sub Text(Text As String)
txtOutput.SelStart = Len(txtOutput.Text)
txtOutput.SelText = Text & vbCrLf
End Sub

Private Sub sckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Data As String, MainData() As String, SplitData() As String
sckServer(Index).GetData Data, vbString
MainData = Split(Data, vbCrLf)
For x = LBound(MainData) To UBound(MainData) - 1
SplitData = Split(MainData(x), vbTab)
Select Case SplitData(0)
Case "Message"
SendMessage SplitData(1)
Case "Name"
User(Index).Name = SplitData(1)
SendMessage User(Index).Name & " has joined the chat!"
End Select
Next x
End Sub

Private Sub txtInput_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyReturn
SendMessage "Server Message: " & txtInput.Text
txtInput.Text = ""
End Select
End Sub

Private Sub SendMessage(Message As String)
Text Message
For x = 0 To 49
If User(x).FreeSocket = False Then sckServer(x).SendData "Message" & vbTab & Message & vbCrLf
DoEvents
Next x
End Sub